home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / egads.e < prev    next >
Text File  |  1994-02-05  |  14KB  |  424 lines
  1. /*--------------------------------------------------------------------*
  2.   Egads.e - Demo of creating, modifying, reading, and freeing relative
  3.             gadgets WITHOUT GadTools:  vertical propgadget, horizontal
  4.             propgadget, and two buttons.
  5.  
  6.   Hacked together by Barry Wills.
  7.   This source code is hereby placed in the public domain.  Use it,
  8.   don't abuse it...and certainly don't abuse me. :-)  No guarantees
  9.   except that it runs on my machine. :-) :-)
  10.  
  11.   Pre-v36 folks!  The following are the only v36+ dependent areas of
  12.   this program (I think).  An resourceful individual could code around
  13.   them.
  14.   - LockPubScreen():  to get current font info.
  15.   - UnlockPubScreen():  ditto.
  16.   - NewModifyProp():  use argument of -1 instead of 1.
  17.   - PROPNEWLOOK:  remove it.
  18.  
  19.   UPDATE 0.1:
  20.   - object declaration "screenFont:PTR TO textfont" change to
  21.     "screenFont:PTR TO tf".
  22.  *--------------------------------------------------------------------*/
  23. OPT OSVERSION=36
  24.  
  25. MODULE 'dos/dos',
  26.        'graphics/rastport',
  27.        'graphics/text',
  28.        'intuition/intuition',
  29.        'intuition/screens'
  30.  
  31. RAISE "MEM" IF New () = NIL
  32.  
  33. CONST IDCMP_DEFAULTFLAGS = IDCMP_CLOSEWINDOW + IDCMP_NEWSIZE +
  34.                            IDCMP_GADGETDOWN  + IDCMP_GADGETUP,
  35.       WFLG_DEFAULTFLAGS  = WFLG_ACTIVATE   + WFLG_DRAGBAR     + WFLG_CLOSEGADGET +
  36.                            WFLG_SIZEGADGET + WFLG_DEPTHGADGET + WFLG_NOCAREREFRESH
  37.          /* Note:  you may wish to use another refresh method; the other   */
  38.          /* methods exhibit strange flashing because the gadgets are drawn */
  39.          /* in the window borders and I guess Intuition doesn't like it.   */
  40.  
  41. CONST VERTSCROLLER_FLAGS     = GFLG_GADGHCOMP   + GFLG_RELHEIGHT + GFLG_RELRIGHT,
  42.       VERTSCROLLER_ACTFLAGS  = GACT_IMMEDIATE   + GACT_RELVERIFY +
  43.                                GACT_FOLLOWMOUSE + GACT_RIGHTBORDER,
  44.       HORIZSCROLLER_FLAGS    = GFLG_GADGHCOMP   + GFLG_RELWIDTH  + GFLG_RELBOTTOM,
  45.       HORIZSCROLLER_ACTFLAGS = GACT_IMMEDIATE   + GACT_RELVERIFY +
  46.                                GACT_FOLLOWMOUSE + GACT_BOTTOMBORDER
  47.  
  48. CONST MAX_WIDTH = 2000,
  49.       MAX_HEIGHT = 2000
  50.  
  51. DEF scr = NIL    : PTR TO screen,
  52.     rastport     : PTR TO rastport,
  53.     screenFont   : PTR TO tf,
  54.     win = NIL    : PTR TO window,
  55.     idcmpMessage : PTR TO intuimessage,
  56.     idcmpClass, offy, offx
  57.  
  58. DEF gads = NIL,
  59.     horizontalScroller : PTR TO gadget,
  60.     verticalScroller   : PTR TO gadget,
  61.     upButton           : PTR TO gadget,
  62.     downButton         : PTR TO gadget,
  63.     currentVert = 0, currentHoriz = 0
  64.  
  65.  
  66. /*-----------------------------------------------------------------*/
  67. /*-- Create/Free Gadgets ------------------------------------------*/
  68. /*-----------------------------------------------------------------*/
  69.  
  70. PROC newVerticalScroller ()
  71.   DEF g   : PTR TO gadget,
  72.       vsi : PTR TO image,
  73.       pi  : PTR TO propinfo
  74.   g := New (SIZEOF gadget)
  75.   vsi := New (SIZEOF image)
  76.   pi := New (SIZEOF propinfo)
  77.   pi.flags := (FREEVERT + AUTOKNOB + PROPNEWLOOK)
  78.   g.leftedge := -15
  79.   g.topedge := offy+12
  80.   g.width := 13
  81.   /*-- Intuition uses title height of 8, so I must --*/
  82.   /*-- adjust for *real* title font height:        --*/
  83.   g.height := -45 - (screenFont.ysize-8)
  84.   g.flags := VERTSCROLLER_FLAGS
  85.   g.activation := VERTSCROLLER_ACTFLAGS
  86.   g.gadgettype := GTYP_PROPGADGET
  87.   g.gadgetrender := vsi
  88.   g.specialinfo := pi
  89.   g.nextgadget := NIL
  90. ENDPROC  g
  91.   /* newVerticalScroller */
  92.  
  93. PROC newHorizontalScroller ()
  94.   DEF g   : PTR TO gadget,
  95.       hsi : PTR TO image,
  96.       pi  : PTR TO propinfo
  97.   g := New (SIZEOF gadget)
  98.   hsi := New (SIZEOF image)
  99.   pi := New (SIZEOF propinfo)
  100.   pi.flags := (FREEHORIZ + AUTOKNOB + PROPNEWLOOK)
  101.   g.leftedge := offx
  102.   g.topedge := -9
  103.   g.width := -22
  104.   g.height := 8
  105.   g.flags := HORIZSCROLLER_FLAGS
  106.   g.activation := HORIZSCROLLER_ACTFLAGS
  107.   g.gadgettype := GTYP_PROPGADGET
  108.   g.gadgetrender := hsi
  109.   g.specialinfo := pi
  110.   g.nextgadget := NIL
  111. ENDPROC  g
  112.   /* newHorizontalScroller */
  113.  
  114. PROC newUpButton ()
  115.   DEF g : PTR TO gadget,
  116.       upGadgetRender1 : PTR TO border,
  117.       upGadgetRender2 : PTR TO border,
  118.       upGadgetRender3 : PTR TO border,
  119.       upSelectRender1 : PTR TO border,
  120.       upSelectRender2 : PTR TO border,
  121.       upSelectRender3 : PTR TO border,
  122.       upXY1 : PTR TO INT,
  123.       upXY2 : PTR TO INT,
  124.       upXY3 : PTR TO INT
  125.   upXY3 := [ 3,6,  8, 4, 12, 6] : INT    /* Little arrow.          */
  126.   upXY2 := [16,0, 16,10,  0,10] : INT    /* Right and bottom edge. */
  127.   upXY1 := [15,0,  -1, 0,  -1,10] : INT  /* Left and top edge.     */
  128.   upGadgetRender3 := [0,0,1,0,RP_JAM1,3, upXY3, NIL] : border
  129.   upGadgetRender2 := [0,0,1,0,RP_JAM1,3, upXY2, upGadgetRender3] : border
  130.   upGadgetRender1 := [0,0,2,0,RP_JAM1,3, upXY1, upGadgetRender2] : border
  131.   upSelectRender3 := [0,0,1,0,RP_JAM1,3, upXY3, NIL] : border
  132.   upSelectRender2 := [0,0,2,0,RP_JAM1,3, upXY2, upSelectRender3] : border
  133.   upSelectRender1 := [0,0,1,0,RP_JAM1,3, upXY1, upSelectRender2] : border
  134.   g := New (SIZEOF gadget)
  135.   g.leftedge := -16
  136.   g.topedge := -31
  137.   g.width := 15
  138.   g.height := 11
  139.   g.flags := (GFLG_RELBOTTOM + GFLG_RELRIGHT + GFLG_GADGHIMAGE)
  140.   g.activation := (GACT_RELVERIFY + GACT_IMMEDIATE)
  141.   g.gadgettype := GTYP_BOOLGADGET
  142.   g.gadgetrender := upGadgetRender1
  143.   g.selectrender := upSelectRender1
  144.   g.nextgadget := NIL
  145. ENDPROC  g
  146.   /* newUpButton */
  147.  
  148. PROC newDownButton ()
  149.   DEF g : PTR TO gadget,
  150.       downGadgetRender1 : PTR TO border,
  151.       downGadgetRender2 : PTR TO border,
  152.       downGadgetRender3 : PTR TO border,
  153.       downSelectRender1 : PTR TO border,
  154.       downSelectRender2 : PTR TO border,
  155.       downSelectRender3 : PTR TO border,
  156.       downXY1 : PTR TO INT,
  157.       downXY2 : PTR TO INT,
  158.       downXY3 : PTR TO INT
  159.   downXY3 := [ 3,4,  8, 6, 12, 4] : INT    /* Little arrow.          */
  160.   downXY2 := [16,0, 16,10,  0,10] : INT    /* Right and bottom edge. */
  161.   downXY1 := [15,0,  -1, 0,  -1,10] : INT  /* Left and top edge.     */
  162.   downGadgetRender3 := [0,0,1,0,RP_JAM1,3, downXY3, NIL] : border
  163.   downGadgetRender2 := [0,0,1,0,RP_JAM1,3, downXY2, downGadgetRender3] : border
  164.   downGadgetRender1 := [0,0,2,0,RP_JAM1,3, downXY1, downGadgetRender2] : border
  165.   downSelectRender3 := [0,0,1,0,RP_JAM1,3, downXY3, NIL] : border
  166.   downSelectRender2 := [0,0,2,0,RP_JAM1,3, downXY2, downSelectRender3] : border
  167.   downSelectRender1 := [0,0,1,0,RP_JAM1,3, downXY1, downSelectRender2] : border
  168.   g := New (SIZEOF gadget)
  169.   g.leftedge := -16
  170.   g.topedge := -20
  171.   g.width := 15
  172.   g.height := 11
  173.   g.flags := (GFLG_RELBOTTOM + GFLG_RELRIGHT + GFLG_GADGHIMAGE)
  174.   g.activation := (GACT_RELVERIFY + GACT_IMMEDIATE)
  175.   g.gadgettype := GTYP_BOOLGADGET
  176.   g.gadgetrender := downGadgetRender1
  177.   g.selectrender := downSelectRender1
  178.   g.nextgadget := NIL
  179. ENDPROC  g
  180.   /* newDownButton */
  181.  
  182. PROC newGadgets ()
  183.   DEF glist, g : PTR TO gadget
  184.   /*-- Scroller Gadgets. --*/
  185.   g := glist := verticalScroller := newVerticalScroller ()
  186.   g.nextgadget := horizontalScroller := newHorizontalScroller ()
  187.   g := g.nextgadget
  188.   /*-- Scroll Button Gadgets. --*/
  189.   g.nextgadget := upButton := newUpButton ()
  190.   g := g.nextgadget
  191.   g.nextgadget := downButton := newDownButton ()
  192.   g := downButton
  193. ENDPROC  glist
  194.   /* newGadgets */
  195.  
  196. PROC freeGadgets (g : PTR TO gadget)
  197.   DEF ng : PTR TO gadget
  198.   /*-- Dispose of two propgads... --*/
  199.   ng := g.nextgadget
  200.   Dispose (g.specialinfo); Dispose (g.gadgetrender); Dispose (g)
  201.   g := ng; ng := ng.nextgadget
  202.   Dispose (g.specialinfo); Dispose (g.gadgetrender); Dispose (g)
  203.   /*-- ...and two button gads. --*/
  204.   Dispose (ng.nextgadget); Dispose (ng)
  205. ENDPROC
  206.   /* freeGadgets */
  207.  
  208.  
  209. /*-----------------------------------------------------------------*/
  210. /*-- Propgad Calculation Routines ---------------------------------*/
  211. /*-----------------------------------------------------------------*/
  212.  
  213. PROC unsigned (x) RETURN x AND $FFFF
  214.  
  215. PROC signed (x)
  216.   MOVE.L  x,D0
  217.   EXT.L   D0
  218.   MOVE.L  D0,x
  219. ENDPROC  x
  220.   /* signed */
  221.  
  222. PROC setLocation (maxValue, viewSize, value)
  223. /*-- horizPot := value / maxValue * MAXPOT --*/
  224.   IF (maxValue <= viewSize) OR (maxValue-viewSize < value)
  225.     RETURN signed ($FFFF)
  226.   ELSE
  227.     RETURN signed (SpFix(SpMul(SpFlt(MAXPOT),
  228.                                SpDiv(SpFlt(maxValue-viewSize), SpFlt(value)))))
  229.   ENDIF
  230. ENDPROC
  231.   /* setLocation */
  232.  
  233. PROC setSize (maxValue, viewSize)
  234. /*-- horizBody := viewSize / maxValue * MAXBODY --*/
  235.   RETURN signed (SpFix(SpMul(SpFlt(MAXBODY),
  236.                              SpDiv(SpFlt(IF maxValue<viewSize THEN viewSize ELSE maxValue),
  237.                                    SpFlt(viewSize)))))
  238. ENDPROC
  239.   /* setSize */
  240.  
  241. PROC readLocation (maxValue, viewSize, potValue)
  242. /*-- newLineNumber := vertPot / MAXPOT * maxValue --*/
  243.   IF maxValue <= viewSize
  244.     RETURN 0
  245.   ELSE
  246.     RETURN SpFix (SpMul(SpFlt(maxValue-viewSize),
  247.                         SpDiv(SpFlt(MAXPOT),
  248.                               SpFlt(unsigned(potValue)))))
  249.   ENDIF
  250. ENDPROC
  251.   /* readLocation */
  252.  
  253. PROC recalculateHorizontalPropGadget ()
  254.   DEF propInfo : PTR TO propinfo
  255.   propInfo := horizontalScroller.specialinfo
  256.   NewModifyProp (horizontalScroller, win, NIL, propInfo.flags,
  257.                  setLocation (MAX_WIDTH, win.width, currentHoriz), 0,
  258.                  setSize (MAX_WIDTH, win.width), 0, 1)
  259. ENDPROC
  260.   /* recalculateHorizontalPropGadget */
  261.  
  262. PROC recalculateVerticalPropGadget ()
  263.   DEF propInfo : PTR TO propinfo
  264.   propInfo := verticalScroller.specialinfo
  265.   NewModifyProp (verticalScroller, win, NIL, propInfo.flags,
  266.                  0, setLocation (MAX_HEIGHT, win.height, currentVert),
  267.                  0, setSize (MAX_HEIGHT, win.height), 1)
  268. ENDPROC
  269.   /* recalculateVerticalPropGadget */
  270.  
  271. /*-----------------------------------------------------------------*/
  272. /*-- Event Handlers -----------------------------------------------*/
  273. /*-----------------------------------------------------------------*/
  274.  
  275. PROC writeValues ()
  276.   TextF (offx+10, rastport.txheight*2+10+offy, 'currentVert  = \d[4]', currentVert)
  277.   TextF (offx+10, rastport.cp_y+rastport.txheight, 'currentHoriz = \d[4]', currentHoriz)
  278. ENDPROC
  279.   /* writeValues */
  280.  
  281. PROC doVerticalScroller ()
  282.   DEF propInfo : PTR TO propinfo
  283.   ModifyIDCMP (win, (IDCMP_DEFAULTFLAGS OR IDCMP_MOUSEMOVE))
  284.   propInfo := verticalScroller.specialinfo
  285.   REPEAT
  286.     IF idcmpMessage := GetMsg (win.userport)
  287.       idcmpClass := idcmpMessage.class
  288.       ReplyMsg (idcmpMessage)
  289.       IF (idcmpClass = IDCMP_MOUSEMOVE) OR (idcmpClass = IDCMP_GADGETUP)
  290.         currentVert := readLocation (MAX_HEIGHT, win.height, propInfo.vertpot)
  291.         SELECT idcmpClass
  292.           CASE IDCMP_MOUSEMOVE; writeValues ()
  293.           CASE IDCMP_GADGETUP;  writeValues ()
  294.         ENDSELECT
  295.       ENDIF
  296.     ELSE
  297.       WaitPort (win.userport)
  298.     ENDIF
  299.   UNTIL idcmpClass = IDCMP_GADGETUP
  300.   recalculateVerticalPropGadget ()
  301.   ModifyIDCMP (win, IDCMP_DEFAULTFLAGS)
  302. ENDPROC
  303.   /* doVerticalScroller */
  304.  
  305. PROC doHorizontalScroller ()
  306.   DEF propInfo : PTR TO propinfo
  307.   ModifyIDCMP (win, (IDCMP_DEFAULTFLAGS OR IDCMP_MOUSEMOVE))
  308.   propInfo := horizontalScroller.specialinfo
  309.   REPEAT
  310.     IF idcmpMessage := GetMsg (win.userport)
  311.       idcmpClass := idcmpMessage.class
  312.       ReplyMsg (idcmpMessage)
  313.       IF (idcmpClass = IDCMP_MOUSEMOVE) OR (idcmpClass = IDCMP_GADGETUP)
  314.         currentHoriz := readLocation (MAX_WIDTH, win.width, propInfo.horizpot)
  315.         writeValues ()
  316.       ENDIF
  317.     ELSE
  318.       WaitPort (win.userport)
  319.     ENDIF
  320.   UNTIL idcmpClass = IDCMP_GADGETUP
  321.   recalculateHorizontalPropGadget ()
  322.   ModifyIDCMP (win, IDCMP_DEFAULTFLAGS)
  323. ENDPROC
  324.   /* doHorizontalScroller */
  325.  
  326. PROC doUpButton ()
  327.   REPEAT
  328.     IF idcmpMessage := GetMsg (win.userport)
  329.       idcmpClass := idcmpMessage.class
  330.       ReplyMsg (idcmpMessage)
  331.     ELSEIF currentVert > 0
  332.       DEC currentVert
  333.       recalculateVerticalPropGadget ()
  334.       writeValues ()
  335.     ENDIF
  336.   UNTIL idcmpClass = IDCMP_GADGETUP
  337. ENDPROC
  338.   /* doUpButton */
  339.  
  340. PROC doDownButton ()
  341.   REPEAT
  342.     IF idcmpMessage := GetMsg (win.userport)
  343.       idcmpClass := idcmpMessage.class
  344.       ReplyMsg (idcmpMessage)
  345.     ELSEIF currentVert < (MAX_HEIGHT-win.height)
  346.       INC currentVert
  347.       recalculateVerticalPropGadget ()
  348.       writeValues ()
  349.     ENDIF
  350.   UNTIL idcmpClass = IDCMP_GADGETUP
  351. ENDPROC
  352.   /* doDownButton */
  353.  
  354.  
  355.  
  356. /*-----------------------------------------------------------------*/
  357. /*-- Shutdown -----------------------------------------------------*/
  358. /*-----------------------------------------------------------------*/
  359.  
  360. PROC openWindow ()
  361.   IF (scr := LockPubScreen ('Workbench')) = NIL THEN Raise ("SCR")
  362.   rastport := scr.rastport
  363.   screenFont := rastport.font
  364.   offy := scr.wbortop + Int (rastport+58) - 10
  365.   offx := scr.wborleft
  366.   IF (win := OpenW (0, 0, 300, 150,
  367.                     IDCMP_DEFAULTFLAGS,
  368.                     WFLG_DEFAULTFLAGS,
  369.                     'E-gads!',
  370.                     scr, CUSTOMSCREEN,
  371.                     gads:=newGadgets())) = NIL THEN Raise ("WIN")
  372.   rastport := stdrast
  373.   Colour (1, 0)
  374.   recalculateVerticalPropGadget ()
  375.   recalculateHorizontalPropGadget ()
  376.   writeValues ()
  377. ENDPROC
  378.   /* openWindow */
  379.  
  380. PROC closeWindow ()
  381.   DEF g
  382.   RemoveGList (win, g:=win.firstgadget, -1)
  383.   freeGadgets (g)
  384.   CloseW (win)
  385. ENDPROC
  386.   /* closeWindow */
  387.  
  388.  
  389. /*-----------------------------------------------------------------*/
  390. /*-- Main ---------------------------------------------------------*/
  391. /*-----------------------------------------------------------------*/
  392.  
  393. PROC main () HANDLE
  394.   DEF whichGadget
  395.   openWindow ()
  396.   REPEAT
  397.     IF idcmpMessage := GetMsg (win.userport)
  398.       idcmpClass := idcmpMessage.class
  399.       whichGadget := idcmpMessage.iaddress
  400.       ReplyMsg (idcmpMessage); idcmpMessage := NIL
  401.       SELECT idcmpClass
  402.         CASE IDCMP_GADGETDOWN;
  403.           SELECT whichGadget
  404.             CASE horizontalScroller; doHorizontalScroller ()
  405.             CASE verticalScroller;   doVerticalScroller ()
  406.             CASE upButton;           doUpButton ()
  407.             CASE downButton;         doDownButton ()
  408.           ENDSELECT
  409.         CASE IDCMP_NEWSIZE;
  410.           recalculateVerticalPropGadget ()
  411.           recalculateHorizontalPropGadget ()
  412.       ENDSELECT
  413.     ELSE
  414.       WaitPort (win.userport)
  415.     ENDIF
  416.   UNTIL idcmpClass = IDCMP_CLOSEWINDOW
  417.   Raise (0)
  418. EXCEPT
  419.   IF win THEN closeWindow () ELSE IF gads THEN freeGadgets (gads)
  420.   IF scr THEN UnlockPubScreen (NIL, scr)
  421.   IF exception THEN WriteF ('\s\n', [exception,0])
  422.   RETURN IF exception THEN RETURN_WARN ELSE RETURN_OK
  423. ENDPROC
  424.